home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TSR / TPPOP18C / WINDOWS.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-22  |  13KB  |  439 lines
  1. {$A+,B-,D+,E+,F-,I+,L+,N+,O-,R-,S-,V-}
  2. Unit Windows;
  3.  
  4. Interface
  5.  
  6. Uses Crt;
  7.  
  8. Const
  9.   On = True;
  10.   Off = False;
  11. Type
  12.   BorderType = (None,Single,Double,DoubleTop,DoubleSide,Solid);
  13.   TitleType = (LeftJustify,Centered,RightJustify);
  14.   ScreenType = Array[0..3999] of Byte;
  15.   ScreenPtr  = ^ScreenRecord;
  16.   ScreenRecord = Record
  17.                    Screen    : ^ScreenType;  { points to saved screen tile  }
  18.                    uX,uY,lX,lY : Byte;       { holds new window coordinates }
  19.                    UpperCors : Word;         { holds old window coordinates }
  20.                    LowerCors : Word;         { holds window coordinates     }
  21.                    OldAttr   : Word;         { holds character attribute    }
  22.                    XY        : Word;         { holds the cursor position    }
  23.                    Cursor    : Word;         { holds the cursor shape       }
  24.                    Previous  : ScreenPtr;    { pointer to underlying window }
  25.                  End;
  26.  
  27.  
  28. Var
  29.   UnderScreen    : ScreenPtr;  { points to the saved screen       }
  30.   UseMono        : Boolean;    { true if use B/W attribute only   }
  31.   TranslateBW    : Boolean;    { change attributes when mono?     }
  32.  
  33. Procedure Initialize;
  34.  
  35. Procedure DrawBox(X1,Y1,X2,Y2,Forground,Background : Integer;
  36.                   Border : BorderType);
  37.  
  38. Procedure Title(Line : String;TitleFormat : TitleType;Border : BorderType);
  39.  
  40. Procedure Footer(Line : String;TitleFormat : TitleType;Border : BorderType);
  41.  
  42. Procedure Cursor(State : Boolean);
  43. { Turns the cursor on or off. }
  44.  
  45. Procedure DuplicateChar(Character : Char;Count : Integer);
  46.  
  47. Procedure DrawVerticalLine(X,Y,Length : Word;Border : BorderType);
  48.  
  49. Procedure DrawHorizontalLine(X,Y,Length : Word;Border :BorderType);
  50.  
  51. Procedure SaveScreen(X1,Y1,X2,Y2 : Integer);
  52.  
  53. Procedure MakeWindow(X1,Y1,X2,Y2,Forground,BackGround : Integer;
  54.                      Border : BorderType);
  55.  
  56. Procedure RemoveWindow;
  57.  
  58. Function VideoMode : Byte;
  59.  
  60.   InLine($B4/$0F/          { mov   ah,0Fh   }
  61.          $CD/$10);         { int   10h      }
  62.  
  63. Procedure GotoXYAbs(XY : Word);
  64.  
  65.   InLine($5A/              { pop   dx       }
  66.          $B4/$02/          { mov   ah,2     }
  67.          $30/$FF/          { xor   bh,bh    }
  68.          $CD/$10);         { int   10h      }
  69.  
  70. Function WhereXYAbs : Word;
  71.  
  72.   InLine($B4/$03/          { mov  ah,3      }
  73.          $30/$FF/          { xor  bh,bh     }
  74.          $CD/$10/          { int  10h       }
  75.          $89/$D0);         { mov  ax,dx     }
  76.  
  77. Procedure SetCursor(Cursor : Word);
  78.  
  79.   InLine($59/              { pop  cx        }
  80.          $B4/$01/          { mov  ah,1      }
  81.          $CD/$10);         { int  10h       }
  82.  
  83. Function CursorShape : Word;
  84.  
  85.   InLine($B4/$03/          { mov  ah,3      }
  86.          $30/$FF/          { xor  bh,bh     }
  87.          $CD/$10/          { int  10h       }
  88.          $89/$C8);         { mov  ax,cx     }
  89.  
  90. Type
  91.   BorderPart = (Top,Side,UpperLeft,UpperRight,LowerLeft,LowerRight,
  92.                 TopConnect,BottomConnect,LeftConnect,RightConnect,Cross);
  93.  
  94. Const
  95.   Borders : Array[Single..Solid,Top..Cross] of Char =
  96.                      (('─','│','┌','┐','└','┘','┬','┴','├','┤','┼'), {single}
  97.                       ('═','║','╔','╗','╚','╝','╦','╩','╠','╣','╬'), {double}
  98.                       ('═','│','╒','╕','╘','╛','╤','╧','╞','╡','╪'), {combo }
  99.                       ('─','║','╓','╖','╙','╜','╥','╨','╟','╢','╫'), {combo }
  100.                       (' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '));{solid }
  101.  
  102. { window type 0 has no border, type 5 uses the space character }
  103.  
  104. Implementation
  105.  
  106. Var
  107.   MonoScreen  : ScreenType Absolute $B000:0000; { monochome screen            }
  108.   ColorScreen : ScreenType Absolute $B800:0000; { CGA screen                  }
  109.   CurrentScreen  : ScreenPtr;                   { place to save screen info   }
  110.   ScreenSaved  : Boolean;                       { Are any windows on the heap?}
  111.  
  112. Procedure Cursor(State : Boolean); External; {$L cursor.obj }
  113.  
  114. Procedure ScreenToBuffer(Var Source,Target : ScreenType;
  115.                          X1,Y1,X2,Y2: Integer);
  116.  
  117. Var
  118.   Loop   : Word;
  119.   Width  : Integer;
  120.   Offset : Integer;
  121.   TIndex : Integer;
  122.   SIndex : Integer;
  123.  
  124. Begin
  125.   Offset := Pred(X1) Shl 1;
  126.   Width := (X2 - Pred(X1)) Shl 1;
  127.   For Loop := Y1 to Y2 Do
  128.   Begin
  129.     SIndex := Pred(Loop) * 160 + Offset;
  130.     TIndex := (Loop-Y1) * Width;
  131.     If CheckSnow Then Repeat Until Port[$3DA] AND 1 = 1;
  132.     Move(Source[SIndex],Target[TIndex],Width);
  133.   End;
  134. End;
  135.  
  136. Procedure BufferToScreen(Var Source,Target : ScreenType;
  137.                          X1,Y1,X2,Y2: Integer);
  138.  
  139. Var
  140.   Loop   : Word;
  141.   Width  : Integer;
  142.   Offset : Integer;
  143.   SIndex : Integer;
  144.   TIndex : Integer;
  145.  
  146. Begin
  147.   Offset := Pred(X1) Shl 1;
  148.   Width := (X2 - Pred(X1)) Shl 1;
  149.   For Loop := Y1 to Y2 Do
  150.   Begin
  151.     TIndex := Pred(Loop) * 160 + Offset;
  152.     SIndex := (Loop-Y1) * Width;
  153.     If CheckSnow Then Repeat Until Port[$3DA] AND 9 = 9;
  154.     Move(Source[SIndex],Target[TIndex],Width);
  155.   End;
  156. End;
  157.  
  158. Procedure SaveScreen(X1,Y1,X2,Y2 : Integer);
  159.  
  160. { saves the screen memory, window coordinates, }
  161. { cursor position, and character attribute.    }
  162.  
  163. Var
  164.   ScreenSize : Integer;
  165.   Width     : Integer;
  166.   Height    : Integer;
  167.   NewScreen      : ScreenPtr;
  168.  
  169. Begin
  170.   Width := Succ(X2) - X1;
  171.   Height := Succ(Y2) - Y1;
  172.   ScreenSize := (Width * Height) Shl 1;
  173.   GetMem(NewScreen,SizeOf(ScreenRecord));
  174.   With NewScreen^ Do
  175.   Begin
  176.     uX := X1;
  177.     uY := Y1;
  178.     lX := X2;
  179.     lY := Y2;
  180.     GetMem(Screen,ScreenSize);
  181.     If ScreenSaved
  182.       Then Previous := CurrentScreen
  183.     Else Previous := Nil;
  184.     ScreenSaved := True;
  185.     If VideoMode = 7
  186.       Then ScreenToBuffer(MonoScreen,Screen^,X1,Y1,X2,Y2)
  187.     Else ScreenToBuffer(ColorScreen,Screen^,X1,Y1,X2,Y2);
  188.     UpperCors := WindMin;           { save the window coordinates }
  189.     LowerCors := WindMax;
  190.     OldAttr := TextAttr;            { save the character attribute }
  191.     XY := WhereXYAbs;               { save the cursor position     }
  192.     Cursor := CursorShape;
  193.   End;
  194.   CurrentScreen := NewScreen;
  195.   UnderScreen := CurrentScreen;
  196. End;
  197.  
  198. Procedure DropWindow;
  199.  
  200. Var
  201.   OldScreen : ScreenPtr;
  202.  
  203. Begin
  204.   With CurrentScreen^ Do
  205.   Begin
  206.     If Previous = Nil Then ScreenSaved := False;
  207.     OldScreen := CurrentScreen;    { release heap memory             }
  208.     CurrentScreen := Previous;
  209.     UnderScreen := CurrentScreen;
  210.     FreeMem(OldScreen,SizeOf(ScreenRecord));
  211.   End;
  212. End;
  213.  
  214. Procedure RemoveWindow;
  215.  
  216. { Restores screen memory, window coordinates, }
  217. { cursor position, and character attribute.   }
  218.  
  219. Var
  220.   Height : Integer;
  221.   Width  : Integer;
  222.   ScreenSize : Integer;
  223.  
  224.  
  225. Begin
  226.   If Not ScreenSaved Then Exit;
  227.   With CurrentScreen^ Do
  228.   Begin
  229.     If VideoMode = 7 Then
  230.       BufferToScreen(Screen^,MonoScreen,uX,uY,lX,lY)
  231.     Else BufferToScreen(Screen^,ColorScreen,uX,uY,lX,lY);
  232.     Width := Succ(lX) - uX;
  233.     Height := Succ(lY) - uY;
  234.     ScreenSize := (Width * Height) Shl 1;
  235.     FreeMem(Screen,ScreenSize);
  236.     WindMin := UpperCors;          { restore the window coordinates  }
  237.     WindMax := LowerCors;
  238.     TextAttr := OldAttr;           { restore the character attribute }
  239.     GotoXYAbs(XY);                 { restore the cursor position     }
  240.     SetCursor(Cursor);
  241.     DropWindow;
  242.   End;
  243. End;
  244.  
  245. Procedure DuplicateChar(Character : Char;Count : Integer);
  246.  
  247. { Uses the BIOS to write multiple copies of a character to the screen }
  248.  
  249. Begin
  250.   InLine($8A/$46/<Character/     { mov   al,byte ptr char[bp] }
  251.          $8B/$4E/<Count/         { mov   cx,count[bp]         }
  252.          $B4/$09/                { mov   ah,09h               }
  253.          $8A/$1E/>TextAttr/      { mov   bl,[TextAttr]        }
  254.          $32/$FF/                { xor   bh,bh                }
  255.          $CD/$10);               { int   10h                  }
  256. End;
  257.  
  258. Procedure HeaderFooter(Line : String;
  259.                        Row : Integer;
  260.                        TitleFormat : TitleType;
  261.                        Border : BorderType);
  262.  
  263. Var
  264.   WMin,WMax : Word;
  265.   oX,oY,X   : Integer;
  266.   Center    : Integer;
  267.   Len       : Integer;
  268.  
  269. Begin
  270.   WMin := WindMin;
  271.   WMax := WindMax;
  272.   oX := WhereX;
  273.   oY := WhereY;
  274.   WindMin := WMin - $0101;
  275.   WindMax := WMax + $0101;
  276.   Len := Length(Line) Shr 1;
  277.   Case TitleFormat Of
  278.     LeftJustify  : X := 3;
  279.     Centered     : X := ((Succ(Lo(WindMax)) - Lo(WindMin)) Shr 1) - Len;
  280.     RightJustify : X := Lo(WindMax) - Lo(Windmin) - Length(Line) - 2;
  281.   End;
  282.   GotoXY(X,Row);
  283.   Write(Borders[Border,RightConnect],Line,Borders[Border,LeftConnect]);
  284.   WindMin := WMin;
  285.   WindMax := WMax;
  286.   GotoXY(oX,oY);
  287. End;
  288.  
  289.  
  290. Procedure Title(Line : String;
  291.                 TitleFormat : TitleType;
  292.                 Border : BorderType);
  293.  
  294. Begin
  295.   HeaderFooter(Line,1,TitleFormat,Border);
  296. End;
  297.  
  298. Procedure Footer(Line : String;
  299.                  TitleFormat : TitleType;
  300.                  Border : BorderType);
  301.  
  302. Begin
  303.   HeaderFooter(Line,Hi(WindMax)-Hi(WindMin)+3,TitleFormat,Border);
  304. End;
  305.  
  306. Procedure FastPutVertical(Ch : Char;Count,Col,Row : Word); External;
  307. Procedure FastPutHorizontal(Ch : Char;Count,Col,Row : Word); External;
  308. {$L fastput.obj}
  309.  
  310. Procedure DrawVerticalLine(X,Y,Length : Word;Border : BorderType);
  311.  
  312. { draws a vertical line with the proper connection }
  313. { type for interfacing with a surrounding window.  }
  314.  
  315. Var
  316.   Loop : Word;
  317.   WMax : Word;
  318.   WMin : Word;
  319.   xX,xY  : Integer;
  320.  
  321. Begin
  322.   WMax := WindMax;
  323.   WMin := WindMin;
  324.   xX := WhereX;
  325.   xY := WhereY;
  326.   Window(1,1,80,25);
  327.   FastPutVertical(Borders[Border,Side],Length-2,X,Succ(Y));
  328.   GotoXY(X,Y);
  329.   Write(Borders[Border,TopConnect]);
  330.   GotoXY(X,Y+Pred(Length));
  331.   Write(Borders[Border,BottomConnect]);
  332.   WindMax := WMax;
  333.   WindMin := WMin;
  334.   GotoXY(xX,xY);
  335. End;
  336.  
  337. Procedure DrawHorizontalLine(X,Y,Length : Word;Border :BorderType);
  338.  
  339. { draws a horizontal line with the proper connection }
  340. { type for interfacing with a surrounding window.    }
  341.  
  342. Var
  343.   Loop : Word;
  344.   WMax : Word;
  345.   WMin : Word;
  346.   xX,xY  : Integer;
  347.  
  348. Begin
  349.   WMax := WindMax;
  350.   WMin := WindMin;
  351.   xX := WhereX;
  352.   xY := WhereY;
  353.   Window(1,1,80,25);
  354.   GotoXY(X,Y);
  355.   Write(Borders[Border,LeftConnect]);
  356.   GotoXY(X+Pred(Length),Y);
  357.   Write(Borders[Border,RightConnect]);
  358.   FastPutHorizontal(Borders[Border,Top],Length-2,Succ(X),Y);
  359.   WindMax := WMax;
  360.   WindMin := WMin;
  361.   GotoXY(xX,xY);
  362. End;
  363.  
  364. Procedure DrawBox(X1,Y1,X2,Y2,Forground,Background : Integer;Border : BorderType);
  365.  
  366. { Draws a double box around the window and reduces the window size. }
  367. { Inputs are the same as for MakeWindow.                            }
  368.  
  369. Var
  370.   Loop : Integer;
  371.  
  372. Begin
  373.   If UseMono Then
  374.   Begin                                 { Make sure the attributes can be }
  375.     Forground := 7;                     { seen on a monochrome screen.    }
  376.     Background := 0;
  377.   End;
  378.   TextColor(Forground);
  379.   TextBackground(Background);
  380.   Window(1,1,80,25);
  381.   If Border = None
  382.     Then Window(X1,Y1,X2,Y2)
  383.   Else Begin
  384.     FastPutVertical(Borders[Border,Side],Y2-Y1,X1,Succ(Y1));
  385.     FastPutVertical(Borders[Border,Side],Y2-Y1,X2,Succ(Y1));
  386.     GotoXY(X1,Y1);
  387.     FastPutHorizontal(Borders[Border,Top],X2-X1,X1,Y1);{ top         }
  388.     FastPutHorizontal(Borders[Border,Top],X2-X1,X1,Y2);{ bottom      }
  389.     Write(Borders[Border,UpperLeft]);                  { upper left  }
  390.     GotoXY(X2,Y1);
  391.     Write(Borders[Border,UpperRight]);                 { upper right }
  392.     GotoXY(X1,Y2);
  393.     Write(Borders[Border,LowerLeft]);                  { lower left  }
  394.     FastPutHorizontal(Borders[Border,LowerRight],1,X2,Y2); { lower right }
  395.     Window(Succ(X1),Succ(Y1),Pred(X2),Pred(Y2)); { reduce the window size }
  396.   End;
  397.   ClrScr;
  398. End;
  399.  
  400. Procedure MakeWindow(X1,Y1,X2,Y2,Forground,BackGround : Integer;
  401.                      Border : BorderType);
  402.  
  403. { Saves the screen and draws a box. }
  404.  
  405. { Inputs are:  The four window coordinates,        }
  406. {              the forground color,                }
  407. {              the background color, and           }
  408. {              the border type (see DrawBox)       }
  409.  
  410. Begin
  411.   SaveScreen(X1,Y1,X2,Y2);
  412.   DrawBox(X1,Y1,X2,Y2,Forground,Background,Border);
  413. End;
  414.  
  415. Function EGA : Boolean;
  416.  
  417. Begin
  418.   If (MemW[$C000:$001E] = $4249) And (Mem[$C000:$0020] = $4D)
  419.     Then EGA := TRUE
  420.   Else EGA := FALSE;
  421. End;
  422.  
  423. Procedure Initialize;
  424.  
  425. Begin
  426.   UseMono := FALSE;
  427.   ScreenSaved := FALSE;
  428.   UnderScreen := Nil;           { no screens saved }
  429.   DirectVideo := TRUE;
  430.   CheckSnow := TRUE;
  431.   If (VideoMode = 7) Or EGA Then CheckSnow := FALSE;
  432.   If VideoMode = 7 Then UseMono := True;
  433. End;
  434.  
  435. Begin
  436.   Initialize;
  437. End.
  438.  
  439.